home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Compute! Gazette 1986 March
/
1986-03.d64
/
coord demos
(
.txt
)
< prev
next >
Wrap
Commodore BASIC
|
2022-09-20
|
5KB
|
112 lines
5 rem *** load ml from disk or tape ***
10 d=8:e=65:a=e:f=147:e$=chr$(f):p=57812:l=62631:s=62957:ifpeek(687)=54then25
15 pokef,0:syspchr$(e)+" coord.obj",d,1:sysl:e=e+1:ife<a+2then15
20 rem *** set coordinator variables ***
25 reset=681:clear=686:plot=707:erase=714
30 setflag=767:init=1020:mflag=0:rem mflag=1 turns on multicolor, 0 is off
35 rem *** set color registers ***
40 fg=646:bo=53280:bg=bo+1
45 ifmfthenm2=bo+2:m3=bo+3:pokem2,6:pokem3,4:rem set multicolor regs. (m1=fg)
50 rem *** set hi-res variables ***
55 bank=1:scnoffset=1:coloffset=7
60 rem *** create display (note changes from magazine listing) ***
65 pokebo,0:pokebg,0:pokefg,1:printe$:printtab(90)" choose demonstration "
70 pokefg,6:print" note: this menu is provided for disk subscribers only ";
75 print"and results in changes":printtab(7)"to the published listing":pokefg,1
80 print:print:print"> press d [146] to run the demo and return"
85 printtab(13)"to this menu":print"> press m [146] to run the mountain demo -"
90 print" which includes the save/load routine"
95 print:print"> press any other key to end the program"
100 poke198,0
105 getnr$:on-(nr$="")-2*(nr$="d")-3*(nr$="m")goto105,115,120
110 goto175
115 gosub185:goto365
120 gosub185:goto465
150 rem *** restore default display ***
155 ifpeek(198)=0then155:rem wait for a keypress to end program
160 poke198,0:rem tidy up keypress if it comes
165 pokefg,peek(bg)+1:rem ensure text color is different from background
170 poke53270,200:poke56576,151:poke53265,27:poke53272,21:ifsfthenreturn
175 end
180 rem *** set up hi-res ***
185 poke56576,(peek(56576)and252)or(3-bank):rem set bank
190 poke53265,peek(53265)or32:rem turn on bitmap
195 ifmfthenpoke53270,peek(53270)or16:rem set multicolor if desired
200 poke53272,(coloffset*16+scnoffset*8):rem position hi-res and color memories
205 return
210 rem *** screen save/load subroutine ***
215 rem note: is dependent on variables from main program
220 d=8:e=49:ok=1:b(1)=ba*64+sc*32:t(1)=b(1)+32:b(2)=ba*64+co*4:t(2)=b(2)+4
225 b(3)=208:t(3)=b(3)+1:b(4)=216:t(4)=b(4)+4:sf=1:gosub165:sf=0
230 printe$:print
235 printtab(7)"** save or load screen **":print:input" screen name";sn$
240 gv=len(sn$):on-(gv<1orgv>15)goto230:print
245 print"> for save - press s[146]":print:print"> for load - press l[146]"
250 getl$:ifl$=""orl$<>"s"andl$<>"l"then250
255 print:print:print" results[146] - name is "sn$:printtab(11)"and this is a ";
260 ifl$="s"thenprint"save":goto270
265 print"load"
270 print:print:printtab(6)">> if correct - press c[146] <<"
275 print:printtab(5)"any other key allows changes"
280 getm$:on-(m$="")-2*(m$="c")goto280,290
285 goto230
290 printe$:print" saving:"sn$:ifl$="l"thenprinte$:print" loading:"sn$:goto320
295 sysp"@:"+chr$(e)+sn$,d,1:poke193,0:poke194,b(ok)
300 poke174,0:poke175,t(ok):syss
305 e=e+1:ok=ok+1:ifok<4then295
310 ifmfandok=4then295
315 goto340
320 pokef,0:syspchr$(e)+sn$,d,1:sysl
325 e=e+1:ife<52then320
330 ifmfande=52then320
335 ifd<>8then355
340 qa=0:open15,8,15:input#15,qa,qb$,qc,qd:close15:ifqa<20then355
345 printe$:print" disk error!":print:printtab(13)" disk status [146]"
350 print:printtab(7)qa;qb$;qc;qd:end
355 gosub185:return
360 rem *** demo ***
365 pokebo,0:pokebg,0:pokefg,1:y=100:x=160:sysclear:o=x:n=y:rem set screen
370 forr=7to87step8:pokebg,-(r/8>7)*r/7:pokefg,r/7-8*(r/8>7):rem radius & color
375 fora=0to(NULL)/2step2/r:x=r*sin(a)+o:y=r*cos(a)+n:sysplot:rem sweep 90 degrees
380 x=-x+2*o:sysplot:y=-y+2*n:sysplot:x=-x+2*o:sysplot:rem but plot 4 quadrants
385 nexta
390 nextr
395 ifmfthenpokem3,5:rem bit pattern 1,1 plots green if multicolor
400 y=100:forx=0to319:pokebg,x/8:pokefg,x/8+1:sysplot:next:remdraw colored line
405 pokebg,0:pokefg,10:forx=0to319:syserase:next:rem erase line with lt. red
410 y=95:pokefg,1:forx=0to319:sysplot:ifpeek(setflag)thensysplot:goto420
415 syserase:rem 395-405 move a white point but don't erase
420 next
425 deffnmc(a)=int(a)-(int(a/2)<>int(a)/2):syscl:r=95:poke646,2
430 fora=0to319step2.26:x=fnmc(a):y=r+80*sin(a/20):syser:x=x+1:syspl:next
435 fora=0to319step2.26:x=fnmc(a):y=r+60*sin(a/25):syspl:x=x+1:syser:next
440 fora=0to319step2.26:x=fnmc(a):y=r+40*sin(a/30):syspl:x=x+1:syspl:next
445 fora=0to319step2.26:x=fnmc(a):y=r+60*sin(a/25):syser:x=x+1:syser:next
450 sf=1:gosub165:sf=0:goto65
460 rem *** mountain demo ***
465 poke198,0:pokefg,11:pokebg,0:pokebo,0:x=-1:y=-1:syscl
466 j%=rnd(0)*10:j%=-j%*(j%>3andj%<7):on-(j%=0)goto466:j%=j%-4:c=2^j%
467 j=35-(c=1)*17:v=2:a=-20:j%=rnd(0)*5:b=-j%*20:z=1:e=0
468 h=int((320-b)/(j-10)):dim g(h+1):g(0)=b:deffnp(m)=(-1)^int(rnd(0)*3)
469 deffnm(r)=(n+(n<80)*n*.3)/133+(n>180)*(n-180)/79
470 forq=1toh:g(q)=g(q-1)+j+rnd(0)*10:ifg(q)>=320theno=q:q=h
471 next:dimr(o+1,2),t(o+1,2),u(o+1),b(o+1):j%=rnd(0)*5:m=10+(j%+4-c)*5
472 j%=-(c>1):r(0,0)=g(0):t(0,0)=rnd(0)*3.3-a:u(0)=1
473 forq=1too:r(q,0)=g(q):u(q)=u(q-1)*(1+2*(q/c=int(q/c)))
474 t(q,0)=t(q-1,0)+((rnd(0)*3.3+2)*u(q)):n=r(q,0)
475 t(q,0)=t(q,0)-(n<=160)*n/80+(n>160)*n/120:gosub483:b(q)=-(k>i):next:e=1
476 v=v+.004:m=m+v^1.0001:r(0,1)=r(0,0)+.9+rnd(0)*.5*fnp(m)
477 t(0,1)=t(0,0)+rnd(0)*2:forq=1too
478 r(q,1)=r(q,0)+(1+(b(q)=0andb(q+1)=1)*j%)*(rnd(1)*(2+c/2)+.3)
479 n=r(q,1):t(q,1)=t(q-1,1)+t(q,0)-t(q-1,0)+rnd(0)*2
480 t(q,1)=t(q,1)-(b(q)=1)*rnd(1)*m*fnm(r)/20:ifr(q,1)>r(q-1,1)then482
481 r(q,1)=r(q-1,1)+.01:ifq>=3thent(q,1)=t(q-1+(c=1)*2,1)-6
482 gosub483:r(q,0)=r(q,1):t(q,0)=t(q,1):next:r(0,0)=r(0,1):t(0,0)=t(0,1):goto476
483 h=r(q-1,e):i=t(q-1,e):j=r(q,e):k=t(q,e)
484 w=(j-h)*(1.3+rnd(0)*.9-(k<i)*1.7*(rnd(0)+1))/sqr((j-h)^2+(k-i)^2)
485 ifk>170andj>0andj<320thenj=r(q,0):k=t(q,0):z=0
486 forx=htojstepw:y=i+(k-i)*(x-h)/(j-h):syspl:next:ifzthenreturn
487 fory=0to199step8:forx=0to319step8:u=fnp(m)*rnd(0)*24
488 pokefg,7+2*(y>36+u)-9*(y>76+u)+13*(y>114+u):syser:ifpeek(se)thensyspl
489 next:next:poke49,peek(47):poke50,peek(48):gosub220:goto155